home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / windows / wtouch.zip / WTOUCH.PAS < prev    next >
Pascal/Delphi Source File  |  1992-04-30  |  6KB  |  208 lines
  1. {****  WTouch 1.0 Copyright 1992 Doug Overmyer ********}
  2. program WTouch;
  3. {$R wtouch.RES}
  4. uses WinTypes, WinProcs, WObjects, StdDlgs,Strings,windos,commdlg,
  5.         win31,sclptext;
  6. const
  7.   WT_Name =  'WTouch';
  8.   id_StH       = 101;
  9.   id_STJ       = 201;
  10.   idm_WTChange = 301;
  11.   idm_WTShowHide=302;
  12.   um_ReSize    = 401;
  13.   id_About     = 501;
  14.   id_CMGetFiles =601;
  15.   id_CMDOIT =    602;
  16.   id_CMExit =    610;
  17. {**********************  TYPES      ******************************}
  18. type
  19.   TWTApp = object(TApplication)
  20.   procedure InitMainWindow; virtual;
  21. end;
  22.  
  23. PWTWindow = ^TWTWindow;
  24. TWTWindow = object(TWindow)
  25.   StH,StJ:PSText;
  26.   FilesBuf:PChar;
  27.      CurTime:LongInt;
  28.   constructor Init(ATitle: PChar);
  29.   destructor Done; virtual;
  30.   procedure SetupWindow;virtual;
  31.   procedure IDCMGetFiles(Var Msg:TMessage);virtual cm_First+id_CMGetFiles;
  32.   procedure IDCMDOIT(Var Msg:TMessage);virtual cm_First+id_CMDOIT;
  33.   procedure IDCMExit(Var Msg:TMessage);virtual cm_First+id_CMExit;
  34.   procedure SetHeader(Msg:Pchar);
  35.   procedure    WMSysCommand(var Msg:TMessage);virtual wm_First+wm_SysCommand;
  36. end;
  37. {*********************  Functions  *******************************}
  38. function StrTok(P:PChar;C:Char):PChar;
  39. const
  40.     Next:Pchar = nil;
  41. begin
  42.     if P = NIL then P := Next;
  43.   if P <> NIL then
  44.       begin
  45.       Next := StrScan(P,C);
  46.       If Next <> NIL then
  47.           begin
  48.         Next^ := #0;
  49.         Next := Next+1;
  50.           end;
  51.       end;
  52.   StrTok := P;
  53. end;
  54. {**********************  METHODS    ******************************}
  55. procedure TWTApp.InitMainWindow;
  56. begin
  57.   MainWindow := New(PWTWindow, Init(WT_Name));
  58. end;
  59. {**********************  TWTWindow  *******************************}
  60. constructor TWTWindow.Init(ATitle: PChar);
  61. var
  62.   Indx:Integer;
  63. begin
  64.   TWindow.Init(nil, ATitle);
  65.   with Attr do
  66.     begin
  67.     X := 50; Y := 50; W := 305; H := 100;
  68.          Attr.Style := ws_Overlapped or ws_SysMenu or ws_MinimizeBox;
  69.     Menu := LoadMenu(hInstance,'WT_Menu');
  70.     end;
  71.   StH := New(PSText,Init(@Self,id_StH,'',15,30,275,20,sr_Recessed,
  72.               dt_Center or dt_VCenter or dt_SingleLine));
  73.   StJ := New(PSText,Init(@Self,id_StJ,'',15,5,275,20,sr_Recessed,
  74.               dt_Center or dt_VCenter or dt_SingleLine));
  75.   GetMem(FilesBuf,4096);
  76.   StrCopy(FilesBuf,'');
  77. end;
  78.  
  79. destructor TWTWindow.Done;
  80. begin
  81.     FreeMem(FilesBuf,4096);
  82.   TWindow.Done;
  83. end;
  84.  
  85. procedure TWTWindow.SetupWindow;
  86. var
  87.   SysMenu:HMenu;
  88. begin
  89.   TWindow.SetupWindow;
  90.   SetClassWord(HWindow,GCW_HIcon,LoadIcon(HInstance,'WT_Icon'));
  91.   SetClassWord(HWindow,GCW_HBrBackground,GetStockObject(ltGray_Brush));
  92.   Sysmenu := GetSystemMenu(hWindow,false);
  93.   AppendMenu(SysMenu,MF_Separator,0,nil);
  94.   AppendMenu(Sysmenu,0,id_About,'About...');
  95.   SetHeader('');
  96.     end;
  97.  
  98. procedure TWTWindow.SetHeader(Msg:PChar);
  99. var
  100.  Buf:Array[0..200] of Char;
  101.  DT:TDateTime;
  102.  Fil:Word;
  103. begin
  104.     GetDate(DT.Year, DT.Month,DT.Day,fil);
  105.   GetTime(DT.Hour,DT.Min,DT.Sec,fil);
  106.   PackTime(DT,CurTime);
  107.   wvsprintf(Buf,'The file Date/Time stamp will be set to...',DT);
  108.   StJ^.SetText(Buf);
  109.   wvsprintf(Buf,'YMD:%u/%u/%u   H:M:S %2u:%2u:%2u',DT);
  110.   StH^.SetText(Buf);
  111. end;
  112.  
  113. procedure TWTWindow.IDCMGetFiles(var Msg:TMessage);
  114. const
  115.   szFilter:Array[0..8] of Char ='*.*'#0'*.*'#0#0;
  116. var
  117.   Path,Name,Ext,OldDir:Array[0..fsPathName] of Char;
  118.     szDirName:Array[0..256] of Char;
  119.   szFile,szFileTitle:Array[0..512] of Char;
  120.   OFN:TOpenFileName;
  121.   P:PChar;
  122. begin
  123.     StrCopy(FilesBuf,'');
  124.   OFN.lStructSize := sizeof(TOpenFileName);
  125.   OFN.hWndOwner := HWindow;
  126.   OFN.lpStrFilter := @szFilter;
  127.   OFN.lpStrCustomFilter := nil;
  128.   OFN.nMaxCustFilter := 0;
  129.   OFN.nFilterIndex := LongInt(1);
  130.   OFN.lpStrFile := FilesBuf;
  131.   OFN.nMaxFile := 4096;
  132.   OFN.lpstrfileTitle := szFileTitle;
  133.   OFN.nMaxFileTitle := sizeof(szFileTitle);
  134.   OFN.lpstrInitialDir := NIL;
  135.   OFN.lpStrTitle := 'Select Files';
  136.   OFN.flags := OFN_ALLOWMULTISELECT;
  137.   OFN.nFileOffset := 0;
  138.   OFN.nFileExtension := 0;
  139.   OFN.lpstrDefext := nil;
  140.   GetOpenFileName(OFN) 
  141. end;
  142.  
  143. procedure TWTWindow.IDCMDOIT(var Msg:TMessage);
  144. var
  145.  Path,PathName:Array[0..69] of Char;
  146.  FName:Array[0..18] of Char;
  147.  pResult:PChar;
  148.  Files:PStrCollection;
  149.  Indx:Integer;
  150.  F:File;
  151. begin
  152.     if StrLen(FilesBuf) = 0 then                {0 files - no cigar}
  153.       begin
  154.       MessageBox(HWindow,'Please select files first','Now get this...',mb_IconExclamation);
  155.     Exit;
  156.     end;
  157.     Files := New(PStrCollection,Init(10,10));
  158.     pResult := StrScan(FilesBuf,' ');
  159.   if pResult = NIL then                       {1 file only}
  160.       Files^.Insert(StrNew(FilesBuf))
  161.   else                                        {2 or more  }
  162.       begin
  163.     pResult := StrTok(FilesBuf,' ');          {get the path}
  164.     StrCopy(Path,pResult);
  165.     SetCurDir(Path);                          {chdir there}
  166.     pResult := StrTok(NIL,' ');               {get the 1st filename}
  167.     while pResult <> NIL do
  168.         begin
  169.       FileExpand(PathName,pResult);           {expand file name}
  170.         Files^.Insert(StrNew(PathName));        {store it in collection}
  171.         pResult := StrTok(NIL,' ');             {get next file name}
  172.         end;
  173.     end;
  174.   for Indx := 0 to (Files^.Count -1) do       {process the selected files}
  175.       begin
  176.     pResult := Files^.At(Indx);
  177.     Assign(F,PResult);
  178.     Reset(F);
  179.     SetFTime(F,CurTime);
  180.     Close(F);
  181.     end;
  182.   Dispose(Files,Done);                         {clean up collection}
  183. end;
  184.  
  185. procedure TWTWindow.IDCMExit(var Msg:TMessage);
  186. begin
  187.     CloseWindow;
  188. end;
  189.  
  190. procedure    TWTWindow.WMSysCommand(var Msg:TMessage);
  191. begin
  192.     case Msg.Wparam of
  193.         id_About:
  194.              application^.ExecDialog(New(PDialog,Init(@Self,'WT_About')));
  195.        else
  196.            DefWndProc(Msg);
  197.        end;
  198. end;
  199.  
  200. {**********************  MainLine   *******************************}
  201. var
  202.   WTApp: TWTApp;
  203. begin
  204.   WTApp.Init(WT_Name);
  205.   WTApp.Run;
  206.   WTApp.Done;
  207. end.
  208.